home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PASDEMO2
/
HYK-TEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-11-20
|
3KB
|
106 lines
PROGRAM Print_Text_1;
TYPE
Array80 = String[80];
CONST
Title = ' ** Printing Text File Program **';
FormFeed = #12;
PathLength = 55;
VerticalTabLength = 3;
VAR
OneRecord : Array80;
InFile, Printer : Text;
RecordLength : Integer;
LineCount : Integer;
PROCEDURE PrintEmphChars;
VAR
EmphSet, EmphRelease : String[2];
Esc : Char;
BEGIN
Esc := chr(27);
EmphSet := Esc + 'E';
EmphRelease := Esc + 'F';
Write( Printer, chr(27) + 'G' );
Write( Printer, chr(27) + '-' + chr(1) );
Write( Printer, chr(27) + 'E' );
Write( Printer, OneRecord );
Write( Printer, chr(27) + 'F' );
Write( Printer, chr(27) + '-' + chr(0) );
Writeln( Printer, chr(27) + 'H' );
LineCount := LineCount + 1
END; { PrintEmphChars }
Procedure VerticalTab;
var i : Integer;
begin
for i := 1 to VerticalTabLength do writeln( Printer, '' );
end;
PROCEDURE Checking;
CONST
Space = ' ';
TYPE
Capital = SET OF Char;
VAR
AllUpperCase : Boolean;
UpperCase : Capital;
i : Integer;
BEGIN
UpperCase := [ 'A' .. 'Z' ];
AllUpperCase := True;
FOR i := 1 TO RecordLength DO
BEGIN
IF NOT ( OneRecord[i] IN UpperCase ) and ( OneRecord[i] <> Space )
THEN AllUpperCase := False
END; { for }
IF AllUpperCase
THEN PrintEmphChars
ELSE
BEGIN
Write( Printer, chr(27) + 'G' );
Write( Printer, OneRecord );
Writeln( Printer, chr(27) + 'H' );
Writeln( Printer, ' ' );
LineCount := LineCount + 2;
If LineCount > PathLength then
begin
Writeln( Printer, FormFeed );
VerticalTab;
LineCount := 1;
end;
END; { else }
END; { Checking }
PROCEDURE OpenFile;
VAR
FileName : String[11];
BEGIN
Writeln( Title );
Writeln;
Write( 'Print what file ? ');
Readln( Filename );
Assign( InFile, FileName );
Reset( InFile );
Assign( Printer, 'LST:' );
Rewrite( Printer )
END;
PROCEDURE ProcessPrinting;
BEGIN
WHILE NOT Eof( InFile ) DO
BEGIN
Readln( InFile, OneRecord );
RecordLength := Length( OneRecord );
IF Length( OneRecord ) = 0
THEN Writeln( Printer, OneRecord )
ELSE Checking
END; { While }
END; { ProcessPrinting }
BEGIN
ClrScr;
OpenFile;
ProcessPrinting;
Close( InFile );
Close( Printer )
End.